(** Module GenGLR contains:
 *  - calls grammar transformation and tokens generation
 *  - function, which generates grammar for Elkhound
 *
 *  Author: Ilia
 *)

open IL
open Production
open Misc
open Generation
open Diagnostics
open GenElkTokens
open Namer
open Transform


(** GLR generation (grammar for Elkhound) *)

let genContext = sprintf "\ncontext_class %s {};"

let genHead = function 
    | None -> "" 
    | Some x -> let text = getText x in
      String.concat "\n" ["\nimpl_verbatim {"; text; "}\n"]

let genTknInclude tokFile = String.concat "\n" 
    ["\nterminals {"; "  include(\"" ^ tokFile ^ "\")"; "}\n"]

let genSemi s = 
    let len = String.length s in 
    if len > 0 && s.[len - 1] = '}' then s else (s ^ ";")

let genAction indent a = 
    if a <> None 
    then 
      let actText = genOptText a in 
      let indent' = if String.length actText > 40 then "\n" ^ indent else " "
      in sprintf "%s{%s}" indent' actText
    else ""

let rec genProduct indent' = 
    (*let indent' = indent ^ "  " in *)
    function
      PAlt (l, r) -> 
      let l' = genSemi (genProduct indent' l)
      and r' = genProduct indent' r
      in sprintf "%s\n%s-> %s" l' indent' r'
    | PSeq (seq, a) ->  
      let elem e = genProduct indent' e.rule in
      let rec genList = function
        | [] -> ""
        | h::t -> let bind = genOptText h.binding in
          let bind' = if bind <> "" then (bind ^ ":") else "" in
          let h' = elem h in
          match t with 
          [] -> sprintf "%s%s" bind' h'
          | _ -> sprintf "%s%s %s" bind' h' (genList t)
      in (genList seq) ^ (genAction indent' a)
    
    | PRef (t, _) 
    | PToken t 
    | PLiteral t -> getText t

    | _ -> "// If you see this comment then say: \"I found bug, the bug!\"=)\n"

let isPredicateRule n =
    let len = String.length Names.predicate in
    if String.length n > len && String.sub n 0 len = Names.predicate 
    then true
    else false

let genKeepFun ruleName seq =
    if isPredicateRule ruleName then (
      match seq with
      | PSeq (h::_, _) -> 
        sprintf "  fun keep(%s) {%s}\n" getKeepParamName (genOptText h.checker)
      | _ -> 
        let errMsg = sprintf "in transforming predicate %s" ruleName
        in reportError errMsg ; ""
    ) else ""

let genRule r = 
    let body = genProduct "  " r.Rule.body in
    sprintf "nonterm(%s) %s {\n%s  -> %s\n}" 
      (createTypeName r.Rule.name) 
      r.Rule.name 
      (genKeepFun r.Rule.name r.Rule.body)
      (genSemi body)

let genGrammar g = 
    let rules = String.concat "\n\n" (List.map genRule g) 
    in rules

let generator conf gram  = 
    let fname = getMandatoryStringOption conf "o" in 
    let title = sprintf "// Generated with YARD (%s@%s)\n%s"
                  Version.version
                  Version.date
                  "// Grammar for Elkhound\n"
    in (*dumpIL gram.Definition.grammar ;*)
    let tokFile = (*dumpTree gram.Definition.grammar ;*) 
                  createTknFileName fname in
    let _ = genTokens tokFile gram.Definition.grammar in
    let grammar = transform gram.Definition.grammar
    in let text = sprintf "%s\n%s%s\n%s"
                    (genContext (nameWithoutExt fname))
                    (genHead gram.Definition.head) 
                    (genTknInclude tokFile)
                    (genGrammar grammar)
                    (*genOpt Source.toString gram.Definition.foot*)
    in 
    let outChan = open_out_bin fname 
    in (*dumpIL "afterMetaRulesExpanding.dump" grammar ;*)
       output_string outChan (title ^ text)

let options =
    Settings.customize (Settings.empty())
    [ "o", Settings.String, Settings.Mandatory, " fname\t-output file name"] 
    (fun () -> [])
